home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Internet Tools 1995 April / Internet Tools.iso / infoserv / www / html / elisp / html-mode.el.Z / html-mode.el
Encoding:
Text File  |  1994-06-28  |  33.1 KB  |  928 lines
  1. ;;; --------------------------------------------------------------------------
  2. ;;; HTML mode, based on text mode.
  3. ;;; Copyright (C) 1985 Free Software Foundation, Inc.
  4. ;;; Copyright (C) 1992, 1993 National Center for Supercomputing Applications.
  5. ;;; NCSA modifications by Marc Andreessen (marca@ncsa.uiuc.edu).
  6. ;;;
  7. ;;; This program is free software; you can redistribute it and/or
  8. ;;; modify it under the terms of the GNU General Public License as
  9. ;;; published by the Free Software Foundation; either version 1, or
  10. ;;; (at your option) any later version.
  11. ;;;
  12. ;;; This program is distributed in the hope that it will be useful,
  13. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15. ;;; General Public License for more details.
  16. ;;;
  17. ;;; You should have received a copy of the GNU General Public License
  18. ;;; along with GNU Emacs; see the file COPYING.  If not, write to the
  19. ;;; Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  20. ;;;
  21. ;;; -------------------------------- CONTENTS --------------------------------
  22. ;;;
  23. ;;; html-mode: Major mode for editing HTML hypertext documents.
  24. ;;; Revision: 2.1 (beta)
  25. ;;;
  26. ;;; Changes from 2.0 (beta):
  27. ;;;   - Ripped out numeric anchor name stuff altogether (all names should be
  28. ;;;     meaningful, not just numbers).
  29. ;;;   - Fixed problem with unquoted names.
  30. ;;;   - Fixed font-lock support (yeah! thanks lamour@engin.umich.edu).
  31. ;;;
  32. ;;; ------------------------------ INSTRUCTIONS ------------------------------
  33. ;;;
  34. ;;; Put the following code in your .emacs file:
  35. ;;;
  36. ;;; (autoload 'html-mode "html-mode" "HTML major mode." t)
  37. ;;; (or (assoc "\\.html$" auto-mode-alist)
  38. ;;;   (setq auto-mode-alist (cons '("\\.html$" . html-mode) 
  39. ;;;                               auto-mode-alist)))
  40. ;;;
  41. ;;; Emacs will detect the ``.html'' suffix and activate html-mode
  42. ;;; appropriately.
  43. ;;;
  44. ;;; You are assumed to be at least somewhat familiar with the HTML
  45. ;;; format.  If you aren't, read about it first (see below).
  46. ;;;
  47. ;;; Here are key sequences and corresponding commands:
  48. ;;;
  49. ;;; NORMAL COMMANDS:
  50. ;;;
  51. ;;; C-c a         html-add-address
  52. ;;;   Open an address element.
  53. ;;;
  54. ;;; C-c b         html-add-blockquote
  55. ;;;
  56. ;;; C-c C-b       html-add-bold
  57. ;;;   Open a bold element.
  58. ;;;
  59. ;;; C-c c         html-add-code
  60. ;;;   Open a 'code' (fixed-font) element.
  61. ;;;
  62. ;;; C-c C-c       html-add-citation
  63. ;;;
  64. ;;; C-c d         html-add-description-list
  65. ;;;   Open a definition list.  The initial entry is created for you.
  66. ;;;   To create subsequent entries, use 'C-c e'.
  67. ;;;
  68. ;;; C-c e         html-add-description-entry
  69. ;;;   Add a new definition entry in a definition list.  You are
  70. ;;;   assumed to be inside a definition list (specifically, at the end
  71. ;;;   of another definition entry).
  72. ;;;
  73. ;;; C-c C-e       html-add-emphasized
  74. ;;;   Open an emphasized element.
  75. ;;;
  76. ;;; C-c C-f       html-add-fixed
  77. ;;;
  78. ;;; C-c g         html-add-img
  79. ;;;   Add an IMG element (inlined image or graphic).  Note that the
  80. ;;;   IMG tag is currently an extension to HTML supported only by the
  81. ;;;   NCSA Mosaic browser (to my knowledge).  You will be prompted for
  82. ;;;   the URL of the image you wish to inline into the document.
  83. ;;;
  84. ;;; C-c h         html-add-header
  85. ;;;   Add a header.  You are prompted for size (1 is biggest, 2 is
  86. ;;;   next biggest; bottom limit is 6) and header contents.
  87. ;;;
  88. ;;; C-c i         html-add-list-or-menu-item
  89. ;;;   Add a new list or menu item in a list or menu.  You are assumed
  90. ;;;   to be inside a list or menu (specifically, at the end of another
  91. ;;;   item).
  92. ;;;
  93. ;;; C-c C-i       html-add-italic
  94. ;;;   Open an italic element.
  95. ;;;
  96. ;;; C-c C-k       html-add-keyboard
  97. ;;;
  98. ;;; C-c l         html-add-normal-link
  99. ;;;   Add a link.  You will be prompted for the link (any string;
  100. ;;;   e.g., http://foo.bar/argh/blagh).  The cursor will be left where
  101. ;;;   you can type the text that will represent the link in the
  102. ;;;   document.
  103. ;;;
  104. ;;; C-c C-l       html-add-listing
  105. ;;;
  106. ;;; C-c m         html-add-menu
  107. ;;;   Open a menu.  The initial item is created for you.  To create
  108. ;;;   additional items, use 'C-c i'.
  109. ;;;
  110. ;;; C-c C-m       html-add-sample
  111. ;;;
  112. ;;; C-c n         html-add-numbered-list
  113. ;;;
  114. ;;; C-c p         html-add-paragraph-separator
  115. ;;;   Use this command at the end of each paragraph.
  116. ;;; 
  117. ;;; C-c C-p       html-add-preformatted
  118. ;;;
  119. ;;; C-c r         html-add-normal-reference
  120. ;;;
  121. ;;; C-c s         html-add-list
  122. ;;;   Open a list.  The initial item is created for you.  To create
  123. ;;;   additional items, use 'C-c i'.
  124. ;;;
  125. ;;; C-c C-s       html-add-strong
  126. ;;;
  127. ;;; C-c t         html-add-title
  128. ;;;   Add a title to the document.  You will be prompted for the
  129. ;;;   contents of the title.  If a title already exists at the very
  130. ;;;   top of the document, the existing contents will be replaced.
  131. ;;;
  132. ;;; C-c C-v       html-add-variable
  133. ;;;
  134. ;;; C-c x         html-add-plaintext
  135. ;;;   Add plaintext.  The cursor will be positioned where you can type
  136. ;;;   plaintext (or insert another file, or whatever).
  137. ;;;
  138. ;;; C-c z         html-preview-document
  139. ;;;   Fork off a Mosaic process to preview the current document.
  140. ;;;   After you do this once, subsequent invocations of
  141. ;;;   html-preview-document will cause the same Mosaic process to be
  142. ;;;   used; this magic is accomplished through Mosaic's ability to be
  143. ;;;   remote-controlled via Unix signals.  This feature is only
  144. ;;;   available when running Lucid Emacs v19 (it will maybe work with
  145. ;;;   GNU Emacs v19; I'm not sure).
  146. ;;;
  147. ;;; COMMANDS THAT OPERATE ON THE CURRENT REGION:
  148. ;;;
  149. ;;; C-c C-r l     html-add-normal-link-to-region
  150. ;;;   Add a link that will be represented by the current region.  You
  151. ;;;   will be prompted for the link (any string, as with
  152. ;;;   html-add-normal-link).
  153. ;;;
  154. ;;; C-c C-r r     html-add-reference-to-region
  155. ;;;   Add a reference (a link that does not reference anything) that
  156. ;;;   will be represented by the current region.  You will be prompted
  157. ;;;   for the name of the link.
  158. ;;;
  159. ;;; SPECIAL COMMANDS:
  160. ;;;
  161. ;;; <, >, &
  162. ;;;   These are overridden to output <, >, and &
  163. ;;;   respectively.  The real characters <, >, and & can be entered
  164. ;;;   into the text either by typing 'C-c' before typing the character
  165. ;;;   or by using the Emacs quoted-insert (C-q) command.
  166. ;;;
  167. ;;; C-c <, C-c >, C-c &
  168. ;;;   See '<, >, &' above.
  169. ;;;
  170. ;;; ---------------------------- ADDITIONAL NOTES ----------------------------
  171. ;;;
  172. ;;; If you are running Epoch or Lucid Emacs, highlighting will be used
  173. ;;; to deemphasize HTML message elements as they are created.  You can
  174. ;;; turn this off; see the variables 'html-use-highlighting' and 
  175. ;;; 'html-use-font-lock'.
  176. ;;;
  177. ;;; HREF and NAME arguments in anchors should always be quoted.  In
  178. ;;; some existing HTML documents, they are not.  html-mode will
  179. ;;; automatically quotify all such unquoted arguments when it
  180. ;;; encounters them.  The following variables affect this behavior.
  181. ;;;
  182. ;;; html-quotify-hrefs-on-find       (variable, default t)
  183. ;;;   If this is non-nil, all HREF arguments will be quotified
  184. ;;;   automatically when a HTML document is loaded into Emacs
  185. ;;;   (actually when html-mode is entered).
  186. ;;;
  187. ;;; -------------------------------- GOTCHAS ---------------------------------
  188. ;;;
  189. ;;; HTML documents can be tricky.  html-mode is not smart enough to
  190. ;;; enforce correctness or sanity, so you have to do that yourself.
  191. ;;;
  192. ;;; ------------------------- WHAT HTML-MODE IS NOT --------------------------
  193. ;;;
  194. ;;; html-mode is not a mode for *browsing* HTML documents.  In
  195. ;;; particular, html-mode provides no hypertext or World Wide Web
  196. ;;; capabilities.
  197. ;;;
  198. ;;; The World Wide Web browser we (naturally) recommend is NCSA
  199. ;;; Mosaic, which can be found at ftp.ncsa.uiuc.edu in /Mosaic.
  200. ;;;
  201. ;;; See file://moose.cs.indiana.edu/pub/elisp/w3 for w3.el, which is
  202. ;;; an Elisp World Wide Web browser written by William Perry.
  203. ;;;
  204. ;;; ------------------------------ WHAT HTML IS ------------------------------
  205. ;;;
  206. ;;; HTML (HyperText Markup Language) is a format for hypertext
  207. ;;; documents, particularly in the World Wide Web system.  For more
  208. ;;; information on HTML, telnet to info.cern.ch or pick up a copy of
  209. ;;; NCSA Mosaic for the X Window System via ftp to ftp.ncsa.uiuc.edu
  210. ;;; in /Mosaic; information is available online through the software
  211. ;;; products distributed at those sites.
  212. ;;;
  213. ;;; ---------------------------- ACKNOWLEDGEMENTS ----------------------------
  214. ;;;
  215. ;;; Some code herein provided by:
  216. ;;;   Dan Connolly <connolly@pixel.convex.com>
  217. ;;;
  218. ;;; --------------------------------------------------------------------------
  219. ;;; LCD Archive Entry:
  220. ;;; html-mode|Marc Andreessen|marca@ncsa.uiuc.edu|
  221. ;;; Major mode for editing HTML hypertext files.|
  222. ;;; Date: sometime in 1993|Revision: 2.1 (beta)|~/modes/html-mode.el.Z|
  223. ;;; --------------------------------------------------------------------------
  224.  
  225. ;;; ---------------------------- emacs variations ----------------------------
  226.  
  227. (defvar html-running-lemacs (if (string-match "Lucid" emacs-version) t nil)
  228.   "Non-nil if running Lucid Emacs.")
  229.  
  230. (defvar html-running-epoch (boundp 'epoch::version)
  231.   "Non-nil if running Epoch.")
  232.  
  233. ;;; ------------------------------- variables --------------------------------
  234.  
  235. (defvar html-quotify-hrefs-on-find t
  236.   "*If non-nil, all HREF's (and NAME's) in a file will be automatically 
  237. quotified when the file is loaded.  This is useful for converting ancient 
  238. HTML documents to SGML-compatible syntax, which mandates quoted HREF's.
  239. This should always be T.")
  240.  
  241. (defvar html-use-highlighting html-running-epoch
  242.   "*Flag to use highlighting for HTML directives in Epoch or Lucid Emacs; 
  243. if non-NIL, highlighting will be used.  Default is T if you are running
  244. Epoch; nil otherwise (for Lucid Emacs, font-lock is better; see 
  245. html-use-font-lock instead).")
  246.  
  247. (defvar html-use-font-lock html-running-lemacs
  248.   "*Flag to use font-lock for HTML directives in Lucid Emacs.  If non-NIL,
  249. font-lock will be used.  Default is T if you are running with Lucid Emacs;
  250. NIL otherwise.  This doesn't currently seem to work.  Bummer.  Ten points
  251. to the first person who tells me why not.")
  252.  
  253. (defvar html-deemphasize-color "grey80"
  254.   "*Color for de-highlighting HTML directives in Epoch or Lucid Emacs.")
  255.  
  256. (defvar html-emphasize-color "yellow"
  257.   "*Color for highlighting HTML something-or-others in Epoch or Lucid Emacs.")
  258.  
  259. (defvar html-document-previewer "/usr/local/bin/xmosaic"
  260.   "*Program to be used to preview HTML documents.  Program is assumed
  261. to accept a single argument, a filename containing a file to view; program
  262. is also assumed to follow the Mosaic convention of handling SIGUSR1 as
  263. a remote-control mechanism.")
  264.  
  265. (defvar html-document-previewer-args "-ngh"
  266.   "*Arguments to be given to the program named by html-document-previewer;
  267. NIL if none should be given.")
  268.  
  269. (defvar html-sigusr1-signal-value 16
  270.   "*Value for the SIGUSR1 signal on your system.  See, usually,
  271. /usr/include/sys/signal.h.")
  272.  
  273. ;;; --------------------------------- setup ----------------------------------
  274.  
  275. (defvar html-mode-syntax-table nil
  276.   "Syntax table used while in html mode.")
  277.  
  278. (defvar html-mode-abbrev-table nil
  279.   "Abbrev table used while in html mode.")
  280. (define-abbrev-table 'html-mode-abbrev-table ())
  281.  
  282. (if html-mode-syntax-table
  283.     ()
  284.   (setq html-mode-syntax-table (make-syntax-table))
  285.   (modify-syntax-entry ?\" ".   " html-mode-syntax-table)
  286.   (modify-syntax-entry ?\\ ".   " html-mode-syntax-table)
  287.   (modify-syntax-entry ?' "w   " html-mode-syntax-table))
  288.  
  289. (defvar html-mode-map nil "")
  290. (if html-mode-map
  291.     ()
  292.   (setq html-mode-map (make-sparse-keymap))
  293.   (define-key html-mode-map "\t" 'tab-to-tab-stop)
  294.   (define-key html-mode-map "\C-ca" 'html-add-address)
  295.   (define-key html-mode-map "\C-cb" 'html-add-blockquote)
  296.   (define-key html-mode-map "\C-cc" 'html-add-code)
  297.   (define-key html-mode-map "\C-cd" 'html-add-description-list)
  298.   (define-key html-mode-map "\C-ce" 'html-add-description-entry)
  299.   (define-key html-mode-map "\C-cg" 'html-add-img)
  300.   (define-key html-mode-map "\C-ch" 'html-add-header)
  301.   (define-key html-mode-map "\C-ci" 'html-add-list-or-menu-item)
  302.   (define-key html-mode-map "\C-cl" 'html-add-normal-link)
  303.   (define-key html-mode-map "\C-cm" 'html-add-menu)
  304.   (define-key html-mode-map "\C-cn" 'html-add-numbered-list)
  305.   (define-key html-mode-map "\C-cp" 'html-add-paragraph-separator)
  306.   (define-key html-mode-map "\C-cr" 'html-add-normal-reference)
  307.   (define-key html-mode-map "\C-cs" 'html-add-list)
  308.   (define-key html-mode-map "\C-ct" 'html-add-title)
  309.   (define-key html-mode-map "\C-cx" 'html-add-plaintext)
  310.   ;; html-preview-document currently requires the primitive
  311.   ;; signal-process, which is only in v19 (is it in gnu 19? dunno).
  312.   (and html-running-lemacs
  313.        (define-key html-mode-map "\C-cz" 'html-preview-document))
  314.   (define-key html-mode-map "\C-c\C-b" 'html-add-bold)
  315.   (define-key html-mode-map "\C-c\C-c" 'html-add-citation)
  316.   (define-key html-mode-map "\C-c\C-e" 'html-add-emphasized)
  317.   (define-key html-mode-map "\C-c\C-f" 'html-add-fixed)
  318.   (define-key html-mode-map "\C-c\C-i" 'html-add-italic)
  319.   (define-key html-mode-map "\C-c\C-k" 'html-add-keyboard)
  320.   (define-key html-mode-map "\C-c\C-l" 'html-add-listing)
  321.   (define-key html-mode-map "\C-c\C-m" 'html-add-sample)
  322.   (define-key html-mode-map "\C-c\C-p" 'html-add-preformatted)
  323.   (define-key html-mode-map "\C-c\C-s" 'html-add-strong)
  324.   (define-key html-mode-map "\C-c\C-v" 'html-add-variable)
  325.   (define-key html-mode-map "<" 'html-less-than)
  326.   (define-key html-mode-map ">" 'html-greater-than)
  327.   (define-key html-mode-map "&" 'html-ampersand)
  328.   (define-key html-mode-map "\C-c<" 'html-real-less-than)
  329.   (define-key html-mode-map "\C-c>" 'html-real-greater-than)
  330.   (define-key html-mode-map "\C-c&" 'html-real-ampersand)
  331.   (define-key html-mode-map "\C-c\C-rl" 'html-add-normal-link-to-region)
  332.   (define-key html-mode-map "\C-c\C-rr" 'html-add-reference-to-region)
  333. )
  334.  
  335. ;;; ------------------------------ highlighting ------------------------------
  336.  
  337. (if (and html-running-epoch html-use-highlighting)
  338.     (progn
  339.       (defvar html-deemphasize-style (make-style))
  340.       (set-style-foreground html-deemphasize-style html-deemphasize-color)
  341.       (defvar html-emphasize-style (make-style))
  342.       (set-style-foreground html-emphasize-style html-emphasize-color)))
  343.  
  344. (if (and html-running-lemacs html-use-highlighting)
  345.     (progn
  346.       (defvar html-deemphasize-style (make-face 'html-deemphasize-face))
  347.       (set-face-foreground html-deemphasize-style html-deemphasize-color)
  348.       (defvar html-emphasize-style (make-face 'html-emphasize-face))
  349.       (set-face-foreground html-emphasize-style html-emphasize-color)))
  350.  
  351. (if html-use-highlighting
  352.     (progn
  353.       (if html-running-lemacs
  354.           (defun html-add-zone (start end style)
  355.             "Add a Lucid Emacs extent from START to END with STYLE."
  356.             (let ((extent (make-extent start end)))
  357.               (set-extent-face extent style)
  358.               (set-extent-data extent 'html-mode))))
  359.       (if html-running-epoch
  360.           (defun html-add-zone (start end style)
  361.             "Add an Epoch zone from START to END with STYLE."
  362.             (let ((zone (add-zone start end style)))
  363.               (epoch::set-zone-data zone 'html-mode))))))
  364.  
  365. (defun html-maybe-deemphasize-region (start end)
  366.   "Maybe deemphasize a region of text.  Region is from START to END."
  367.   (and (or html-running-epoch html-running-lemacs)
  368.        html-use-highlighting
  369.        (html-add-zone start end html-deemphasize-style)))
  370.  
  371. ;;; --------------------------------------------------------------------------
  372. ;;; ------------------------ command support routines ------------------------
  373. ;;; --------------------------------------------------------------------------
  374.  
  375. (defun html-add-link (link-object)
  376.   "Add a link.  Single argument LINK-OBJECT is value of HREF in the
  377. new anchor.  Mark is set after anchor."
  378.   (let ((start (point)))
  379.     (insert "<A")
  380.     (insert " HREF=\"" link-object "\">")
  381.     (html-maybe-deemphasize-region start (1- (point)))
  382.     (insert "</A>")
  383.     (push-mark)
  384.     (forward-char -4)
  385.     (html-maybe-deemphasize-region (1+ (point)) (+ (point) 4))))
  386.  
  387. (defun html-add-reference (ref-object)
  388.   "Add a reference.  Single argument REF-OBJECT is value of NAME in the
  389. new anchor.  Mark is set after anchor."
  390.   (let ((start (point)))
  391.     (insert "<A")
  392.     (insert " NAME=\"" ref-object "\">")
  393.     (html-maybe-deemphasize-region start (1- (point)))
  394.     (insert "</A>")
  395.     (push-mark)
  396.     (forward-char -4)
  397.     (html-maybe-deemphasize-region (1+ (point)) (+ (point) 4))))
  398.  
  399. (defun html-add-list-internal (type)
  400.   "Set up a given type of list by opening the list start/end pair
  401. and creating an initial element.  Single argument TYPE is a string,
  402. assumed to be a valid HTML list type (e.g. \"UL\" or \"OL\").
  403. Mark is set after list."
  404.   (let ((start (point)))
  405.     (insert "<" type ">\n")
  406.     (html-maybe-deemphasize-region start (1- (point)))
  407.     (insert "<LI> ")
  408.     ;; Point goes right there.
  409.     (save-excursion
  410.       (insert "\n")
  411.       (setq start (point))
  412.       (insert "</" type ">\n")
  413.       (html-maybe-deemphasize-region start (1- (point)))
  414.       ;; Reuse start to set mark.
  415.       (setq start (point)))
  416.     (push-mark start t)))
  417.  
  418. (defun html-open-area (tag)
  419.   "Open an area for entering text such as PRE, XMP, or LISTING."
  420.   (let ((start (point)))
  421.     (insert "<" tag ">\n")
  422.     (html-maybe-deemphasize-region start (1- (point)))
  423.     (save-excursion
  424.       (insert "\n")
  425.       (setq start (point))
  426.       (insert "</" tag ">\n")
  427.       (html-maybe-deemphasize-region start (1- (point)))
  428.       ;; Reuse start to set mark.
  429.       (setq start (point)))
  430.     (push-mark start t)))
  431.  
  432. (defun html-open-field (tag)
  433.   (let ((start (point)))
  434.     (insert "<" tag ">")
  435.     (html-maybe-deemphasize-region start (1- (point)))
  436.     (setq start (point))
  437.     (insert "</" tag ">")
  438.     (html-maybe-deemphasize-region (1+ start) (point))
  439.     (push-mark)
  440.     (goto-char start)))
  441.  
  442. ;;; --------------------------------------------------------------------------
  443. ;;; -------------------------------- commands --------------------------------
  444. ;;; --------------------------------------------------------------------------
  445.  
  446. ;; C-c a
  447. (defun html-add-address ()
  448.   "Add an address."
  449.   (interactive)
  450.   (html-open-field "ADDRESS"))
  451.  
  452. ;; C-c b
  453. (defun html-add-blockquote ()
  454.   (interactive)
  455.   (html-open-area "BLOCKQUOTE"))
  456.  
  457. ;; C-c C-b
  458. (defun html-add-bold ()
  459.   (interactive)
  460.   (html-open-field "B"))
  461.  
  462. ;; C-c c
  463. (defun html-add-code ()
  464.   (interactive)
  465.   (html-open-field "CODE"))
  466.  
  467. ;; C-c C-c
  468. (defun html-add-citation ()
  469.   (interactive)
  470.   (html-open-field "CITE"))
  471.  
  472. ;; C-c d
  473. (defun html-add-description-list ()
  474.   "Add a definition list.  Blah blah."
  475.   (interactive)
  476.   (let ((start (point)))
  477.     (insert "<DL>\n")
  478.     (html-maybe-deemphasize-region start (1- (point)))
  479.     (insert "<DT> ")
  480.     ;; Point goes right there.
  481.     (save-excursion
  482.       (insert "\n<DD> \n")
  483.       (setq start (point))
  484.       (insert "</DL>\n")
  485.       (html-maybe-deemphasize-region start (1- (point)))
  486.       ;; Reuse start to set mark.
  487.       (setq start (point)))
  488.     (push-mark start t)))
  489.  
  490. ;; C-c e
  491. (defun html-add-description-entry ()
  492.   "Add a definition entry.  Assume we're at the end of a previous
  493. entry."
  494.   (interactive)
  495.   (let ((start (point)))
  496.     (insert "\n<DT> ")
  497.     (save-excursion
  498.       (insert "\n<DD> "))))
  499.  
  500. ;; C-c C-e
  501. (defun html-add-emphasized ()
  502.   (interactive)
  503.   (html-open-field "EM"))
  504.  
  505. ;; C-c C-f
  506. (defun html-add-fixed ()
  507.   (interactive)
  508.   (html-open-field "TT"))
  509.  
  510. ;; C-c g
  511. (defun html-add-img (href)
  512.   "Add an img."
  513.   (interactive "sImage URL: ")
  514.   (let ((start (point)))
  515.     (insert "<IMG SRC=\"" href "\">")
  516.     (html-maybe-deemphasize-region (1+ start) (1- (point)))))
  517.  
  518. ;; C-c h
  519. (defun html-add-header (size header)
  520.   "Add a header."
  521.   (interactive "sSize (1-6; 1 biggest): \nsHeader: ")
  522.   (let ((start (point)))
  523.     (insert "<H" size ">")
  524.     (html-maybe-deemphasize-region start (1- (point)))
  525.     (insert header)
  526.     (setq start (point))
  527.     (insert "</H" size ">\n")
  528.     (html-maybe-deemphasize-region (1+ start) (1- (point)))))
  529.  
  530. ;; C-c i
  531. (defun html-add-list-or-menu-item ()
  532.   "Add a list or menu item.  Assume we're at the end of the
  533. last item."
  534.   (interactive)
  535.   (let ((start (point)))
  536.     (insert "\n<LI> ")))
  537.  
  538. ;; C-c C-i
  539. (defun html-add-italic ()
  540.   (interactive)
  541.   (html-open-field "I"))
  542.  
  543. ;; C-c C-k
  544. (defun html-add-keyboard ()
  545.   (interactive)
  546.   (html-open-field "KBD"))
  547.  
  548. ;; C-c l
  549. (defun html-add-normal-link (link)
  550.   "Make a link"
  551.   (interactive "sLink to: ")
  552.   (html-add-link link))
  553.  
  554. ;; C-c C-l
  555. (defun html-add-listing ()
  556.   (interactive)
  557.   (html-open-area "LISTING"))
  558.  
  559. ;; C-c m
  560. (defun html-add-menu ()
  561.   "Add a menu."
  562.   (interactive)
  563.   (html-add-list-internal "MENU"))
  564.  
  565. ;; C-c C-m
  566. (defun html-add-sample ()
  567.   (interactive)
  568.   (html-open-field "SAMP"))
  569.  
  570. ;; C-c n
  571. (defun html-add-numbered-list ()
  572.   "Add a numbered list."
  573.   (interactive)
  574.   (html-add-list-internal "OL"))
  575.  
  576. ;; C-c p
  577. (defun html-add-paragraph-separator ()
  578.   "Add a paragraph separator."
  579.   (interactive)
  580.   (let ((start (point)))
  581.     (insert " <P>")
  582.     (html-maybe-deemphasize-region (+ start 1) (point))))
  583.  
  584. ;; C-c C-p
  585. (defun html-add-preformatted ()
  586.   (interactive)
  587.   (html-open-area "PRE"))
  588.  
  589. ;; C-c r
  590. (defun html-add-normal-reference (reference)
  591.   "Add a reference (named anchor)."
  592.   (interactive "sReference name: ")
  593.   (html-add-reference reference))
  594.  
  595. ;; C-c s
  596. (defun html-add-list ()
  597.   "Add a list."
  598.   (interactive)
  599.   (html-add-list-internal "UL"))
  600.  
  601. ;; C-c C-s
  602. (defun html-add-strong ()
  603.   (interactive)
  604.   (html-open-field "STRONG"))
  605.  
  606. ;; C-c t
  607. (defun html-add-title (title)
  608.   "Add or modify a title."
  609.   (interactive "sTitle: ")
  610.   (save-excursion
  611.     (goto-char (point-min))
  612.     (if (and (looking-at "<TITLE>")
  613.              (save-excursion
  614.                (forward-char 7)
  615.                (re-search-forward "[^<]*" 
  616.                                   (save-excursion (end-of-line) (point)) 
  617.                                   t)))
  618.         ;; Plop the new title in its place.
  619.         (replace-match title t)
  620.       (insert "<TITLE>")
  621.       (html-maybe-deemphasize-region (point-min) (1- (point)))
  622.       (insert title)
  623.       (insert "</TITLE>")
  624.       (html-maybe-deemphasize-region (- (point) 7) (point))
  625.       (insert "\n"))))
  626.  
  627. ;; C-c C-v
  628. (defun html-add-variable ()
  629.   (interactive)
  630.   (html-open-field "VAR"))
  631.  
  632. ;; C-c x
  633. (defun html-add-plaintext ()
  634.   "Add plaintext."
  635.   (interactive)
  636.   (html-open-area "XMP"))
  637.  
  638. ;;; --------------------------------------------------------------------------
  639. ;;; ---------------------------- region commands -----------------------------
  640. ;;; --------------------------------------------------------------------------
  641.  
  642. ;; C-c C-r l
  643. (defun html-add-normal-link-to-region (link start end)
  644.   "Make a link that applies to the current region.  Again,
  645. no completion."
  646.   (interactive "sLink to: \nr")
  647.   (save-excursion
  648.     (goto-char end)
  649.     (save-excursion
  650.       (goto-char start)
  651.       (insert "<A")
  652.       (insert " HREF=\"" link "\">")
  653.       (html-maybe-deemphasize-region start (1- (point))))
  654.     (insert "</A>")
  655.     (html-maybe-deemphasize-region (- (point) 3) (point))))
  656.  
  657. ;; C-c C-r r
  658. (defun html-add-reference-to-region (name start end)
  659.   "Add a reference point (a link with no reference of its own) to
  660. the current region."
  661.   (interactive "sName: \nr")
  662.   (or (string= name "")
  663.       (save-excursion
  664.         (goto-char end)
  665.         (save-excursion
  666.           (goto-char start)
  667.           (insert "<A NAME=\"" name "\">")
  668.           (html-maybe-deemphasize-region start (1- (point))))
  669.         (insert "</A>")
  670.         (html-maybe-deemphasize-region (- (point) 3) (point)))))
  671.  
  672. ;;; --------------------------------------------------------------------------
  673. ;;; ---------------------------- special commands ----------------------------
  674. ;;; --------------------------------------------------------------------------
  675.  
  676. (defun html-less-than ()
  677.   (interactive)
  678.   (insert "<"))
  679.  
  680. (defun html-greater-than ()
  681.   (interactive)
  682.   (insert ">"))
  683.  
  684. (defun html-ampersand ()
  685.   (interactive)
  686.   (insert "&"))
  687.  
  688. (defun html-real-less-than ()
  689.   (interactive)
  690.   (insert "<"))
  691.  
  692. (defun html-real-greater-than ()
  693.   (interactive)
  694.   (insert ">"))
  695.  
  696. (defun html-real-ampersand ()
  697.   (interactive)
  698.   (insert "&"))
  699.  
  700. ;;; --------------------------------------------------------------------------
  701. ;;; --------------------------- Mosaic previewing ----------------------------
  702. ;;; --------------------------------------------------------------------------
  703.  
  704. ;; OK, we work like this: We have a variable html-previewer-process.
  705. ;; When we start, it's nil.  First time html-preview-document is
  706. ;; called, we write the current document into a tmp file and call
  707. ;; Mosaic on it.  Second time html-preview-document is called, we
  708. ;; write the current document into a tmp file, write out a tmp config
  709. ;; file, and send Mosaic SIGUSR1.
  710.  
  711. ;; This feature REQUIRES the Lisp command signal-process, which seems
  712. ;; to be a Lucid Emacs v19 feature.  It might be in GNU Emacs v19 too;
  713. ;; I dunno.
  714.  
  715. (defvar html-previewer-process nil
  716.   "Variable used to track live viewer process.")
  717.  
  718. (defun html-write-buffer-to-tmp-file ()
  719.   "Write the current buffer to a temp file and return the name
  720. of the tmp file."
  721.   (let ((filename (concat "/tmp/" (make-temp-name "html") ".html")))
  722.     (write-region (point-min) (point-max) filename nil 'foo)
  723.     filename))
  724.  
  725. (defun html-preview-document ()
  726.   "Preview the current buffer's HTML document by spawning off a
  727. previewing process (assumed to be Mosaic, basically) and controlling
  728. it with signals as long as it's alive."
  729.   (interactive)
  730.   (let ((tmp-file (html-write-buffer-to-tmp-file)))
  731.     ;; If html-previewer-process is nil, we start a process.
  732.     ;; OR if the process status is not equal to 'run.
  733.     (if (or (eq html-previewer-process nil)
  734.             (not (eq (process-status html-previewer-process) 'run)))
  735.         (progn
  736.           (message "Starting previewer...")
  737.           (setq html-previewer-process
  738.                 (if html-document-previewer-args
  739.                     (start-process "html-previewer" "html-previewer"
  740.                                    html-document-previewer 
  741.                                    html-document-previewer-args 
  742.                                    tmp-file)
  743.                   (start-process "html-previewer" "html-previewer"
  744.                                  html-document-previewer 
  745.                                  tmp-file))))
  746.       ;; We've got a running previewer; use it via SIGUSR1.
  747.       (save-excursion
  748.         (let ((config-file (format "/tmp/xmosaic.%d" 
  749.                                    (process-id html-previewer-process))))
  750.           (set-buffer (generate-new-buffer "*html-preview-tmp*"))
  751.           (insert "goto\nfile:" tmp-file "\n")
  752.           (write-region (point-min) (point-max)
  753.                         config-file nil 'foo)
  754.           ;; This is a v19 routine only.
  755.           (signal-process (process-id html-previewer-process)
  756.                           html-sigusr1-signal-value)
  757.           (delete-file config-file)
  758.           (delete-file tmp-file)
  759.           (kill-buffer (current-buffer)))))))
  760.  
  761. ;;; --------------------------------------------------------------------------
  762. ;;; --------------------------------------------------------------------------
  763. ;;; --------------------------------------------------------------------------
  764.  
  765. (defun html-replace-string-in-buffer (start end newstring)
  766.   (save-excursion
  767.     (goto-char start)
  768.     (delete-char (1+ (- end start)))
  769.     (insert newstring)))
  770.  
  771. ;;; --------------------------- html-quotify-hrefs ---------------------------
  772.  
  773. (defun html-quotify-hrefs ()
  774.   "Insert quotes around all HREF and NAME attribute value literals.
  775.  
  776. This remedies the problem with old HTML files that can't be processed
  777. by SGML parsers. That is, changes <A HREF=foo> to <A HREF=\"foo\">."
  778.   (interactive)
  779.   (save-excursion
  780.     (goto-char (point-min))
  781.     (while 
  782.         (re-search-forward
  783.          "<[aA][ \t\n]+\\([nN][aA][mM][eE]=[a-zA-Z0-9]+[ \t\n]+\\)?[hH][rR][eE][fF]="
  784.          (point-max)
  785.          t)
  786.       (cond
  787.        ((null (looking-at "\""))
  788.         (insert "\"")
  789.         (re-search-forward "[ \t\n>]" (point-max) t)
  790.         (forward-char -1)
  791.         (insert "\""))))))
  792.  
  793. ;;; ------------------------------- html-mode --------------------------------
  794.  
  795. (defun html-mode ()
  796.   "Major mode for editing HTML hypertext documents.  Special commands:\\{html-mode-map}
  797. Turning on html-mode calls the value of the variable html-mode-hook,
  798. if that value is non-nil.
  799.  
  800. More extensive documentation is available in the file 'html-mode.el'.
  801. The latest (possibly unstable) version of this file will always be available
  802. on anonymous FTP server ftp.ncsa.uiuc.edu in /Mosaic/elisp."
  803.   (interactive)
  804.   (kill-all-local-variables)
  805.   (use-local-map html-mode-map)
  806.   (setq mode-name "HTML")
  807.   (setq major-mode 'html-mode)
  808.   (setq local-abbrev-table html-mode-abbrev-table)
  809.   (set-syntax-table html-mode-syntax-table)
  810.   (run-hooks 'html-mode-hook)
  811.   (and html-use-font-lock
  812.        (html-fontify)))
  813.  
  814. ;;; ------------------------------- our hooks --------------------------------
  815.  
  816. (defun html-html-mode-hook ()
  817.   "Hook called from html-mode-hook.  
  818. Run htlm-quotify-hrefs if html-quotify-hrefs-on-find is non-nil."
  819.   ;; Quotify existing HREF's if html-quotify-hrefs-on-find is non-nil.
  820.   (and html-quotify-hrefs-on-find (html-quotify-hrefs)))
  821.  
  822. ;;; ------------------------------- hook setup -------------------------------
  823.  
  824. ;; Author: Daniel LaLiberte (liberte@cs.uiuc.edu).
  825. (defun html-postpend-unique-hook (hook-var hook-function)
  826.   "Postpend HOOK-VAR with HOOK-FUNCTION, if it is not already an element.
  827. hook-var's value may be a single function or a list of functions."
  828.   (if (boundp hook-var)
  829.       (let ((value (symbol-value hook-var)))
  830.         (if (and (listp value) (not (eq (car value) 'lambda)))
  831.             (and (not (memq hook-function value))
  832.                  (set hook-var (append value (list hook-function))))
  833.           (and (not (eq hook-function value))
  834.                (set hook-var (append value (list hook-function))))))
  835.     (set hook-var (list hook-function))))
  836.  
  837. (html-postpend-unique-hook 'html-mode-hook 'html-html-mode-hook)
  838.  
  839. ;;; -------------------------- lucid menubar setup ---------------------------
  840.  
  841. (if html-running-lemacs
  842.     (progn
  843.       (defvar html-menu
  844.         '("HTML Mode"
  845.           ["Open Address"         html-add-address      t]
  846.           ["Open Blockquote"      html-add-blockquote   t]
  847.           ["Open Header"          html-add-header       t]
  848.           ["Open Hyperlink"       html-add-normal-link  t]
  849.           ["Open Listing"         html-add-listing      t]
  850.           ["Open Plaintext"       html-add-plaintext    t]
  851.           ["Open Preformatted"    html-add-preformatted t]
  852.           ["Open Reference"       html-add-normal-reference    t]
  853.           ["Open Title"           html-add-title        t]
  854.           "----"
  855.           ["Open Bold"            html-add-bold         t]
  856.           ["Open Citation"        html-add-citation     t]
  857.           ["Open Code"            html-add-code         t]
  858.           ["Open Emphasized"      html-add-emphasized   t]
  859.           ["Open Fixed"           html-add-fixed        t]
  860.           ["Open Keyboard"        html-add-keyboard     t]
  861.           ["Open Sample"          html-add-sample       t]
  862.           ["Open Strong"          html-add-strong       t]
  863.           ["Open Variable"        html-add-variable     t]
  864.           "----"
  865.           ["Add Inlined Image"    html-add-img          t]
  866.           ["End Paragraph"        html-add-paragraph-separator t]
  867.           ["Preview Document"     html-preview-document t]
  868.           "----"
  869.           ("Definition List ..."
  870.            ["Open Definition List"    html-add-description-list  t]
  871.            ["Add Definition Entry"    html-add-description-entry t]
  872.            )
  873.           ("Other Lists ..."
  874.            ["Open Unnumbered List"    html-add-list          t]
  875.            ["Open Numbered List"      html-add-numbered-list t]
  876.            ["Open Menu"               html-add-menu          t]
  877.            "----"
  878.            ["Add List Or Menu Item"   html-add-list-or-menu-item   t]
  879.            )           
  880.           ("Operations On Region ..."
  881.            ["Add Hyperlink To Region" html-add-normal-link-to-region  t]
  882.            ["Add Reference To Region" html-add-reference-to-region    t]
  883.            )
  884.           ("Reserved Characters ..."
  885.            ["Less Than (<)"           html-real-less-than      t]
  886.            ["Greater Than (>)"        html-real-greater-than   t]
  887.            ["Ampersand (&)"           html-real-ampersand      t]
  888.            )
  889.           )
  890.         )
  891.  
  892.       (defun html-menu (e)
  893.         (interactive "e")
  894.         (mouse-set-point e)
  895.         (beginning-of-line)
  896.         (popup-menu html-menu))
  897.       (define-key html-mode-map 'button3 'html-menu)
  898.  
  899.       (defun html-install-menubar ()
  900.         (if (and current-menubar (not (assoc "HTML" current-menubar)))
  901.             (progn
  902.               (set-buffer-menubar (copy-sequence current-menubar))
  903.               (add-menu nil "HTML" (cdr html-menu)))))
  904.       (html-postpend-unique-hook 'html-mode-hook 'html-install-menubar)
  905.  
  906.       (defconst html-font-lock-keywords
  907.         (list
  908.          '("\\(<[^>]*>\\)+" . font-lock-comment-face)
  909.          '("[Hh][Rr][Ee][Ff]=\"\\([^\"]*\\)\"" 1 font-lock-string-face t)
  910.          '("[Ss][Rr][Cc]=\"\\([^\"]*\\)\"" 1 font-lock-string-face t))
  911.         "Patterns to highlight in HTML buffers.")
  912.  
  913.       (defun html-fontify ()
  914.         (font-lock-mode 1)
  915.         (make-local-variable 'font-lock-keywords) 
  916.         (setq font-lock-keywords html-font-lock-keywords)
  917.     (font-lock-hack-keywords (point-min) (point-max))
  918.         (message "Hey boss, we been through html-fontify."))
  919.       )
  920.   )
  921.  
  922. ;;; ------------------------------ final setup -------------------------------
  923.  
  924. (or (assoc "\\.html$" auto-mode-alist)
  925.     (setq auto-mode-alist (cons '("\\.html$" . html-mode) auto-mode-alist)))
  926.  
  927. (provide 'html-mode)
  928.